home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / DEMO_VGA / DEMOCGA.LZH / PI.PAS < prev    next >
Pascal/Delphi Source File  |  1986-03-17  |  5KB  |  238 lines
  1.  
  2. {                      PROGRAM PI1.PAS
  3.                         SEPT 2, 1985
  4.  ( IMPROVED VERSION OF PI.PAS WHICH WAS SLOW AND HAD  SOME ERRORS )
  5.  
  6. THIS PROGRAM COMPUTES THE DIGITS OF PI USING THE ARCTANGENT FORMULA
  7. (1)            PI/4 = 4 ARCTAN 1/5 - ARCTAN 1/239
  8. IN CONJUNCTION WITH THE GREGORY SERIES
  9.  
  10. (2)   ARCTAN X = SUM  (-1)^N*(2N + 1)^-1*X^(2N+1)  N=0 TO  INFINITY.
  11.  
  12. SUBSTITUTING INTO (2) A FEW VALUES OF N  AND NESTING  WE HAVE,
  13.  
  14. PI/4 =  1/5[4/1 + 1/25[-4/3 + 1/25[4/5 + 1/25[-4/7 + ...].].]
  15.  
  16.     - 1/239[1/1 + 1/239^2[-1/3 + 1/239^2[1/5 + 1/239^2[-1/7 +...].].]
  17.  
  18. USING THE LONG DIVISION ALGORITHM, THIS ( NESTED ) INFINITE SERIES CAN BE
  19. USED TO CALCULATE PI TO A LARGE NUMBER OF DECIMAL PLACES IN A REASONABLE
  20. AMOUNT OF TIME. A TIME FUNCTION IS INCLUDED TO SHOW HOW SLOW THINGS
  21. GET WHEN N IS LARGE. IMPROVEMENTS CAN BE MADE BY CHANGING THE SIZE OF
  22. THE ARRAY ELEMENTS HOWEVER IT GETS A BIT TRICKY.
  23.  
  24. A LITTLE HISTORY
  25. ----------------
  26.  
  27. IN AUGUST, 1949, PROFESSOR JOHN VON NEUMANN USED THIS FORMULA TO
  28. CALCULATE PI TO OVER 2000 DECIMAL PLACES ON THE  ENIAC  COMPUTER.
  29. THE CALCULATION WAS COMPLETED OVER THE LABOR DAY WEEKEND WITH THE
  30. COMBINED EFFORTS OF FOUR ENIAC STAFF MEMBERS EACH WORKING EIGHT-HOUR
  31. SHIFTS TO ENSURE CONTINUOUS OPERATION OF THE ENIAC.
  32.  
  33. SOME YEARS AGO I REQUESTED INFORMATION ON PI FROM THE ENCYCLOPEDIA
  34. BRITANNICA RESEARCH SERVICE. I RECEIVED A REPORT GIVING THE ABOVE
  35. HISTORICAL ACCOUNT PLUS A LISTING OF THE 2000 DIGITS.
  36.  
  37. IT WAS THIS LISTING THAT ENABLED ME TO CHECK THE PROGRAM AND KEEP
  38. MY SANITY.
  39.  
  40.                         HAVE FUN
  41.                         CINO HILLIARD
  42.                         [72756,672]   }
  43. { PROGRAM PI1.PAS }
  44. Type
  45.   TimeString = string[10];
  46. function time: TimeString;
  47. type
  48.   regpack = record
  49.         ax,bx,cx,dx,bp,di,si,ds,es,flags: integer;
  50.             end;
  51. var
  52.   recpack:          regpack;
  53.   ah,al,ch,cl,dh,dl:   byte;
  54.   hour,min,sec,hds:     string[$2];
  55.   BEGIN
  56.   ah := 2;
  57.   with recpack do
  58.   begin
  59.   ax := ah shl 8 + al;
  60.   end;
  61.  
  62.   intr($1A,recpack);
  63.   with recpack do
  64.   begin
  65.     str(cx shr 8,hour);
  66.     str(cx mod 256,min);
  67.  
  68.     str(dx shr 8,sec);
  69.     str(dx mod 256,hds);
  70. end;
  71. time := hour+':'+min+':'+sec+':'+hds;
  72.  END;
  73.  
  74. VAR B,C,V,P1,S,K,N,I,J,Q,M,M1,X,R,D:INTEGER;
  75.     P,A,T:ARRAY[0..5000] OF INTEGER;TI:STRING[20];
  76. LABEL 10;
  77. CONST F1=5;
  78. CONST F2=239;
  79. PROCEDURE DIVIDE(D:INTEGER);
  80.  BEGIN
  81.     R:=0;
  82.     FOR J:=0 TO M DO
  83.      BEGIN
  84.      V:= R*10+P[J];
  85.      Q:=V DIV D;
  86.      R:=V MOD D;
  87.      P[J]:=Q;
  88.      END;
  89. END;
  90. PROCEDURE DIVIDEA(D:INTEGER);
  91.  BEGIN
  92.     R:=0;
  93.     FOR J:=0 TO M DO
  94.      BEGIN
  95.      V:= R*10+A[J];
  96.      Q:=V DIV D;
  97.      R:=V MOD D;
  98.      A[J]:=Q;
  99.      END;
  100.  END;
  101. PROCEDURE SUBT;
  102. BEGIN
  103. B:=0;
  104. FOR J:=M DOWNTO 0 DO
  105.     IF T[J]>=A[J]  THEN T[J]:=T[J]-A[J] ELSE
  106.     BEGIN
  107.      T[J]:=10+T[J]-A[J];
  108.      T[J-1]:=T[J-1]-1;
  109.    END;
  110. FOR J:=0 TO M DO
  111. A[J]:=T[J];
  112. END;
  113. PROCEDURE SUBA;
  114. BEGIN
  115. FOR J:=M DOWNTO 0 DO
  116.     IF P[J]>=A[J]  THEN P[J]:=P[J]-A[J] ELSE
  117.     BEGIN
  118.      P[J]:=10+P[J]-A[J];
  119.      P[J-1]:=P[J-1]-1;
  120.    END;
  121. FOR J:= M DOWNTO 0 DO
  122. A[J]:=P[J];
  123. END;
  124. PROCEDURE CLEARP;
  125.  BEGIN
  126.   FOR J:=0 TO M DO
  127.    P[J]:=0;
  128.  END;
  129. PROCEDURE ADJUST;
  130. BEGIN
  131. P[0]:=3;
  132. P[M]:=10;
  133. FOR J:=1 TO M-1 DO
  134. P[J]:=9;
  135. END;
  136.  
  137. PROCEDURE ADJUST2;
  138. BEGIN
  139. P[0]:=0;
  140. P[M]:=10;
  141. FOR J:=1 TO M-1 DO
  142. P[J]:=9;
  143. END;
  144.  
  145. PROCEDURE MULT4;
  146.  BEGIN
  147.   C:=0;
  148.   FOR J:=M DOWNTO 0 DO
  149.    BEGIN
  150.     P1:=4*A[J]+C;
  151.     A[J]:=P1 MOD 10;
  152.     C:=P1 DIV 10;
  153.    END;
  154.   END;
  155.  
  156. PROCEDURE SAVEA;
  157. BEGIN
  158. FOR J:=0 TO M DO
  159. T[J]:=A[J];
  160. END;
  161.  
  162. PROCEDURE TERM1;
  163. BEGIN
  164.  I:=M+M+1;
  165.  A[0]:=4;
  166. DIVIDEA(I*25);
  167. WHILE I>3 DO
  168. BEGIN
  169. I:=I-2;
  170. CLEARP;
  171. P[0]:=4;
  172. DIVIDE(I);
  173. SUBA;
  174. DIVIDEA(25);
  175. END;
  176. CLEARP;
  177. ADJUST;
  178. SUBA;
  179. DIVIDEA(5);
  180. SAVEA;
  181. END;
  182. PROCEDURE TERM2;
  183. BEGIN
  184.  I:=M+M+1;
  185.  A[0]:=1;
  186. DIVIDEA(I);
  187. DIVIDEA(239);
  188. DIVIDEA(239);
  189. WHILE I>3 DO
  190. BEGIN
  191. I:=I-2;
  192. CLEARP;
  193. P[0]:=1;
  194. DIVIDE(I);
  195. SUBA;
  196. DIVIDEA(239);
  197. DIVIDEA(239);
  198. END;
  199. CLEARP;
  200. ADJUST2;
  201. SUBA;
  202. DIVIDEA(239);
  203. SUBT;
  204. END;
  205.  
  206. {MAIN PROGRAM}
  207.  
  208.    BEGIN
  209.    CLRSCR;
  210.    WRITELN('                        THE COMPUTATION OF PI');
  211.    WRITELN('                     -----------------------------');
  212. 10:WRITELN('INPUT NO. DECIMAL PLACES');
  213.    READLN(M1);
  214.    TI:=TIME;
  215.    M:=M1+4;
  216.     FOR J:=0 TO M  DO
  217.        BEGIN
  218.          A[J]:=0;
  219.          T[J]:=0;
  220.        END;
  221.    TERM1;
  222.    TERM2;
  223.    MULT4;
  224.    WRITELN;WRITELN;
  225.    WRITE('PI = 3.');
  226.    FOR J:=1 TO M1   DO
  227.    BEGIN
  228.     WRITE(A[J]);
  229.    IF J MOD 5 =0 THEN WRITE(' ');
  230.    IF J MOD 50=0 THEN WRITE('                    ');
  231.    END;
  232.    WRITELN;WRITELN;
  233.    WRITELN('STARTING TIME = ',TI);
  234.    WRITELN('ENDING   TIME = ',TIME);
  235.    WRITELN;
  236.    GOTO 10;
  237. END.
  238.